home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / ddsgen.arc / DDSC.CLP next >
Encoding:
Text File  |  1991-12-04  |  12.0 KB  |  152 lines

  1. /*------------------------------------------------------------------*/          
  2. /*  PROGRAM NAME: DDSC01                                            */          
  3. /*  PURPOSE     : CPP FOR DDSGEN COMMAND                            */          
  4. /*  TYPE        : CL PROGRAM                                        */          
  5. /*                                                                  */          
  6. /*  AUTHOR      : TERRENCE W. MOYER                                 */          
  7. /*                55 KEPPEL AVE                                     */          
  8. /*                WEST LAWN, PA. 19609                              */          
  9. /*                                                                  */          
  10. /*  DATE        : NOVEMBER 1, 1986                                  */          
  11. /*                                                                  */          
  12. /*  *LDA USAGE  : THE FOLLOWING POSITIONS OF THE *LDA ARE RESERVED  */          
  13. /*                BY THE DDS GENERATOR SYSTEM FOR THE FOLLOWING     */          
  14. /*                PURPOSE.                                          */          
  15. /*    1 - 100  ....................INPUT  FILE DATA                 */          
  16. /*  101 - 200  ....................SOURCE FILE DATA                 */          
  17. /*  201 - 300  ....................MISCELLANEOUS SYSTEM DATA        */          
  18. /*                                                                  */          
  19. /*    1 -  10  &INFIL              INPUT FILE NAME                  */          
  20. /*   11 -  20  &INLIB              INPUT FILE LIBRARY               */
  21. /*   21 -  26  %SST(&WHCRTD 2 6)   FILE CREATE DATE  (YYMMDD)       */          
  22. /*   27 -  32  &PHFCTM             FILE CREATE TIME  (HHMMSS)       */          
  23. /*   33 -  33  &WHFTYP             FILE TYPE - P,L,D (PHY/LGL/DEV)  */          
  24. /*   51 - 100  &PHTXT              FILE LEVEL TEXT                  */          
  25. /*  101 - 110  &SRCFIL             SOURCE FILE NAME                 */          
  26. /*  111 - 120  &SRCLIB             SOURCE FILE LIBRARY              */          
  27. /*  121 - 130  &SRCFIL             SOURCE FILE MEMBER               */          
  28. /*  201 - 206                      CURRENT SOURCE SEQUENCE NUMBER.  */          
  29. /*  207 - 212                      DDS SOURCE DATE   (YYMMDD).      */          
  30. /*                                                                  */          
  31. /*  EXTERNAL SWITCHES:                                              */          
  32. /*                                                                  */          
  33. /*  SWITCH 1 - CONTROLS REFERENCE/NO REFERENCE GENERATION.          */          
  34. /*  SWITCH 2 - CONTROLS TEXT/NO TEXT GENERATION.                    */          
  35. /*             (NOTE: TEXT IS ONLY SUPPRESSED IF COLHDG EXISTS)     */          
  36. /*                                                                  */          
  37. /*------------------------------------------------------------------*/          
  38.  PGM         PARM(&INFILENAM &SRCFILENAM &SRCMBR &REF &TEXT)                    
  39.              DCLF FILE(QADSPFFD.QSYS)                                           
  40.              DCL VAR(&INFILENAM)  TYPE(*CHAR) LEN(20)
  41.              DCL VAR(&SRCFILENAM) TYPE(*CHAR) LEN(20)                           
  42.              DCL VAR(&INFIL)      TYPE(*CHAR) LEN(10)                           
  43.              DCL VAR(&INLIB)      TYPE(*CHAR) LEN(10)                           
  44.              DCL VAR(&SRCFIL)     TYPE(*CHAR) LEN(10)                           
  45.              DCL VAR(&SRCLIB)     TYPE(*CHAR) LEN(10)                           
  46.              DCL VAR(&SRCMBR)     TYPE(*CHAR) LEN(10)                           
  47.              DCL VAR(&REF)        TYPE(*CHAR) LEN(5)                            
  48.              DCL VAR(&TEXT)       TYPE(*CHAR) LEN(6)                            
  49.              DCL VAR(&FTYPE)      TYPE(*CHAR) LEN(4)                            
  50.              DCL VAR(&SWS)        TYPE(*CHAR) LEN(8)                            
  51.              DCL VAR(&MSGID)      TYPE(*CHAR) LEN(7)                            
  52.              DCL VAR(&MSGDTA)     TYPE(*CHAR) LEN(80)                           
  53.                                                                                 
  54.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSGS)                       
  55.                                                                                 
  56.              RMVMSG     CLEAR(*ALL) /* CLEAR PGM MSGQ BEFORE BEGIN */           
  57.              RTVJOBA    SWS(&SWS)                                               
  58.              OVRDBF     FILE(QADSPFFD) TOFILE(TEMP.QTEMP)                       
  59.                                                                                 
  60.              CHGVAR     VAR(&INFIL)  VALUE(%SST(&INFILENAM   1 10))
  61.              CHGVAR     VAR(&INLIB)  VALUE(%SST(&INFILENAM  11 10))             
  62.              CHGVAR     VAR(&SRCFIL) VALUE(%SST(&SRCFILENAM  1 10))             
  63.              CHGVAR     VAR(&SRCLIB) VALUE(%SST(&SRCFILENAM 11 10))             
  64.                                                                                 
  65.              IF         COND(&SRCLIB = '*FILE') THEN(CHGVAR +                   
  66.                         VAR(&SRCLIB) VALUE(&INLIB))                             
  67.              IF         COND(%SST(&REF 1 1) = 'R') THEN(CHGJOB +                
  68.                         SWS(0XXXXXXX))        /* USE REFFLD FUNCTION */         
  69.              ELSE       CHGJOB SWS(1XXXXXXX)  /*  NO REFFLD FUNCTION */         
  70.              IF         COND(%SST(&TEXT 1 1)= 'T') THEN(CHGJOB +                
  71.                         SWS(X0XXXXXX))        /* GENERATE TEXT */               
  72.              ELSE       CHGJOB SWS(X1XXXXXX)  /* NO TEXT       */               
  73.                                                                                 
  74.  /* CHECK INPUT FILE AND SOURCE FILE EXISTENCE */                               
  75.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('DDSGEN - +         
  76.                           Checking input values') TOPGMQ(*EXT) +                
  77.                           MSGTYPE(*STATUS)                                      
  78.              CHKOBJ     OBJ(&INFIL.&INLIB)    OBJTYPE(*FILE)                    
  79.              CALL       DDS01CSRC (&SRCFIL &SRCLIB)                             
  80.              IF         COND(&SRCLIB = '*LIBL') THEN(RTVDTAARA +                
  81.                         DTAARA(*LDA (111 10)) RTNVAR(&SRCLIB))                  
  82.                                                                                 
  83.              DSPFFD     FILE(&INFIL.&INLIB) OUTPUT(*NONE) +                     
  84.                         OUTFILE(TEMP.QTEMP)                                     
  85.              RCVF                                                               
  86.              DLTOVR     QADSPFFD                                                
  87.              IF         COND(&INLIB = '*LIBL') THEN(CHGVAR +                    
  88.                         VAR(&INLIB) VALUE(&WHLIB))                              
  89.                                                                                 
  90. /* SET UP THE *LDA */                                                           
  91.              CHGDTAARA  DTAARA(*LDA (  1 10)) VALUE(&INFIL)                     
  92.              CHGDTAARA  DTAARA(*LDA ( 11 10)) VALUE(&INLIB)                     
  93.              CHGDTAARA  DTAARA(*LDA ( 21  6)) VALUE(%SST(&WHCRTD 2 6))          
  94.              CHGDTAARA  DTAARA(*LDA ( 27  6)) VALUE('000000')                   
  95.              CHGDTAARA  DTAARA(*LDA ( 33  1)) VALUE(&WHFTYP)                    
  96.              CHGDTAARA  DTAARA(*LDA (101 10)) VALUE(&SRCFIL)                    
  97.              CHGDTAARA  DTAARA(*LDA (111 10)) VALUE(&SRCLIB)                    
  98.              CHGDTAARA  DTAARA(*LDA (121 10)) VALUE(&SRCMBR)                    
  99. /* VERIFY FILE TYPE IS SUPPORTED BY GENERATOR. */                               
  100.              IF         COND(&WHFTYP *NE 'P') THEN(DO)                          
  101.              IF         (&WHFTYP *EQ 'L') THEN(CHGVAR &FTYPE '*LGL')            
  102.              ELSE  IF   (&WHFTYP *EQ 'D') THEN(CHGVAR &FTYPE '*DEV')            
  103.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&FTYPE +            
  104.                           *CAT ' file type not supported by DDS +               
  105.                           generator')                                           
  106.              GOTO ENDPGM                                                        
  107.              ENDDO                                                              
  108.                                                                                 
  109.  /* CHECK FOR SOURCE MEMBER EXISTENCE - ADD MEMBER IF NOT FOUND */              
  110.  /* CLEAR MEMBER.                                             */                
  111.              IF         COND(&SRCMBR = '*FILE') THEN(CHGVAR +                   
  112.                         VAR(&SRCMBR) VALUE(&INFIL))                             
  113.              CHKOBJ     OBJ(&SRCFIL.&SRCLIB) OBJTYPE(*FILE) +                   
  114.                         MBR(&SRCMBR)                                            
  115.              MONMSG     MSGID(CPF9815) EXEC(DO) /* Member not found. */         
  116.              ADDPFM     FILE(&SRCFIL.&SRCLIB) MBR(&SRCMBR) +                    
  117.                         TEXT('DDS for ' *cat &INFIL *tcat '.' +                 
  118.                               *cat &INLIB)
  119.                         ENDDO                                                   
  120.              CLRPFM     FILE(&SRCFIL.&SRCLIB) MBR(&SRCMBR)                      
  121.              RMVMSG     CLEAR(*ALL) /* RMV ADDPFM AND CLRPFM MSGS */            
  122.                                                                                 
  123. /* CALL APPROPRIATE GENERATOR */                                                
  124.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Checking +         
  125.                           complete.  Working') TOPGMQ(*EXT) +                   
  126.                           MSGTYPE(*STATUS)                                      
  127.              IF   (&WHFTYP *EQ 'P') THEN(DO)                                    
  128.              CALL DDS01CPF PARM(&INFIL &INLIB &SRCFIL &SRCLIB &SRCMBR)          
  129.              ENDDO  /*  PHYSICAL FILE  GENERATOR */                             
  130.                                                                                 
  131.  GOTO ENDPGM                                                                    
  132.                                                                                 
  133. /*       *** RECEIVE AND DISPLAY MONITORED ERROR MESSAGES. ***                */
  134.  RCVMSGS:    RMVMSG     PGMQ(*EXT)  CLEAR(*ALL)                                 
  135.  RCV1:       RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID)                           
  136.              IF         COND(&MSGID = ' ') THEN(DO)                             
  137.                         SNDPGMMSG MSG(' ') TOPGMQ(*EXT)                         
  138.                         GOTO  ENDPGM
  139.                         ENDDO                                                   
  140.              ELSE       DO                                                      
  141.              SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +           
  142.                         TOPGMQ(*EXT) MSGTYPE(*COMP)                             
  143.                         GOTO   RCV1                                             
  144.              ENDDO                                                              
  145.                                                                                 
  146. ENDPGM:      DLTOVR     *ALL                                                    
  147.              CHGJOB     SWS(&SWS)                                               
  148.              ENDPGM
  149. 
  150.